perm filename SMOOTH.FAI[XGP,BGB]1 blob sn#038145 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00014 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	NSUBR BABYKILLER,LEVEL	KILL POLYGONS OF ONE PIXEL
C00005 00003	NSUBR KILIMG,IMG	KILL AN IMAGE
C00006 00004	NSUBR KLPOLY,POLYGON	KILL POLYGON RETURN CCW(PGN)
C00008 00005	NSUBR KLVERT,OBJ	KILL A VERTEX, SKIP IF SUCCESSFUL
C00010 00006	NSUBR FNDPSON,POLYGON	FIND NEW SON IF SON HAS BEEN KILLED OR MOVED
C00011 00007	NSUBR ORTHMUNG,OBJECT	SEARCH FOR ORTHAGONAL LINES AND MUNG THEM ONTO PIXEL BOUNDARIES
C00016 00008	NSUBR SMOOTH,LEVEL
C00019 00009	NSUBR MKARCS,VERT1,VERT2	MAKE ARCS  -  FROM U1 CCW TO U2
C00024 00010	NSUBR FARCL,PGON	FIT ARCS LINEAR.
C00026 00011	----- FARCL		COMPUTE SYMMETRIC LEAST SQUARES LINE COEFFICIENTS.
C00029 00012	NSUBR KILVIC,LEVEL	KILL VIDEO INTENSITY CONTOURS OF THE PREVIOUS LEVEL.
C00031 00013	SUBRS KLARCL,KLARCP	KILL ARCS OF LEVEL, OF POLYGON
C00034 00014	NSUBR(ARCVIC,LVL)MAKE ARC RING INTO VIC RING
C00036 ENDMK
C⊗;
NSUBR BABYKILLER,LEVEL	;KILL POLYGONS OF ONE PIXEL
; -BGB- 28 DEC 1972.
	ACCUMULATORS{A,PG,E0,E1,E2,Q,R}
	SKIPN FLGBK↔POP1J
	MOVE 1,ARG1↔SON PG,1↔MOVEM PG,PG0#
;KLUDGE - SPARE SON POLYGON UNTIL WE CAN THINK OF A POLICY.
	GO L3
;ELIMINATE INSIGNIFICANT CONTOURS - SMALL LOW CONTRAST.
L1:	NCNT 0,PG↔MOVM
	CAIL =10↔GO L3

;RELEASE VIC NODES OF THE POLYGON.
	SON E0,PG
	MOVE  E1,E0
L2:	CCW  E2,E1
	CALL(KILL,E1)
	CAMN E2,E0↔GO .+3
	MOVE  E1,E2↔GO L2

;KILL A BABY POLYGON.
	HLRZ Q,(PG)↔HRRZ R,(PG)
	HRLM Q,(R)↔ HRRM R,(Q)	;RINGO PG.
	CALL(KILL,PG)
	SKIPA PG,R		;CCW FROM OUT OF THE GRAVE.

;ADVANCE TO NEXT POLYGON ON THIS LEVEL.
L3:	CCW PG,PG↔CAME PG,PG0↔GO L1
	POP1J

SUBREND BABYKILLER;6-JAN-73(BGB)
NSUBR KILIMG,IMG	;KILL AN IMAGE
	HRRZ 1,IMG
	SON 1,1
	MOVEM 1,LVL#
	MOVEM 1,LVL0#
LOOP:	MOVE 1,LVL
	JUMPE 1,LDONE
	SON 1,1
	JUMPE 1,PDONE
	CALL(KLPOLY,1)
	GO LOOP
PDONE:	MOVE 1,LVL
	CCW 0,1
	HRRZ 2,IMG
	SON. 0,2
	CAMN 0,LVL0
	SETZM LVL
	CALL(KILL,1)
	GO LOOP
LDONE:	HRRZ 1,IMG
	CCW 2,1
	CAMN 2,1
	GO [ SETZ 2,
	     GO FINISH ]
	CW 3,1
	CCW. 2,3
	CW. 3,2
FINISH:	MOVE 3,FILM
	SON 0,3
	CAMN 0,1
	SON. 2,3
	CAMN 1,QBLK
	MOVEM 2,QBLK
	CALL(KILL,1)
	MOVE 1,FILM
	SON 1,1
	POP1J
SUBREND KILIMG
NSUBR KLPOLY,POLYGON	;KILL POLYGON RETURN CCW(PGN)
; BGB - 7 JANUARY 1973.
	ACCUMULATORS{PG,E0,E1,E2,Q,R}
	MOVE PG,POLYGON

;RELEASE VIC NODES OF THE POLYGON.

	TEST PG,PBIT
	GO [FATAL(KLPOLY CALLED WITH NON-POLYGON)]
	SON E0,PG		;KILL VICS
	MOVE  E1,E0
L1:	CCW  E2,E1
	CALL(KILL,E1)
	CAMN E2,E0↔GO .+3
	MOVE  E1,E2↔GO L1
	ARC E0,PG		;DON'T FORGET THE ARCS!
	MOVE  E1,E0
	TEST E1,ARCBIT
	GO L1B
L1A:	CCW  E2,E1
	CALL(KILL,E1)
	CAMN E2,E0↔GO .+3
	MOVE  E1,E2↔GO L1A

;RING OUT & KILL POLYGON NODE,

L1B:	NGON Q,PG↔PGON R,PG↔JUMPE R,L2
	NGON. Q,R↔PGON. R,Q↔CAMN PG,R↔SETZ R,
	EXO 1,PG↔JUMPE 1,.+4↔ENDO 0,1↔CAMN 0,PG↔ENDO. R,1
	ENDO 1,PG↔SKIPE 1↔HRRZS 3(1) ;MY ENDO BECOMES AN ORPHAN.

L2:	HLRZ Q,(PG)↔HRRZ R,(PG)
	HRLM Q,(R)↔ HRRM R,(Q)	;RINGO PG.

;DOES DAD NEED A NEW FIRST SON.	(MOVED BEFORE CALL TO KILL - TVR)

	DAD 1,R
	CAMN PG,R↔SETZ R,
	SON 0,1↔CAMN 0,PG↔SON. R,1
	CALL(KILL,PG)


;RETURN PGON CCW FROM OUT OF THE GRAVE.
	MOVE 1,R
	POP1J

SUBREND KLPOLY;8-JAN-73(BGB)
NSUBR KLVERT,OBJ	;KILL A VERTEX, SKIP IF SUCCESSFUL
	ACCUMULATORS{THIS,NEXT,LAST,T}
	HRRZ THIS,OBJ
	TYPE T,THIS↔ TRNN T,(VBIT)
	GO [FATAL(AT KLVERT WITHOUT A VERTEX)]
	SKIPN 3(THIS)↔SKIPE 4(THIS)	;CHECK THIS!
	SETZ 0,
	ARC T,THIS↔SKIPE T↔ARC. 0,T	;ZERO ARC POINTER, IF ANY
;	NTIME LAST,THIS↔PTIME NEXT,THIS	;UPDATE PTIME & NTIME
;	SKIPE 6(THIS)↔CAME THIS,NEXT↔GO KLVEC2
;	NTIME. LAST,NEXT↔PTIME. NEXT,LAST
KLVEC2:	CW NEXT,THIS↔CCW LAST,THIS	;UPDATE NEXT & LAST
	CAMN LAST,THIS↔POP1J		;FAILURE RETURN IF LAST VECTOR!
	CW. NEXT,LAST↔CCW. LAST,NEXT
	PUSHP LAST			;SAVE POINTER TO VERTEX TO RETURN
	PGON LAST,THIS			;IF THE VERTEX BEING DELETED POINTED
	NCNT 0,LAST
	SUBI 0,1
	NCNT. 0,LAST
	SON LAST,LAST
	CAMN LAST,THIS			;BY POLYGON, THEN FIX THAT TOO.
	GO [ PUSHACS
	     PGON LAST,THIS
	     CCW 1,THIS
	     SON. 1,LAST		;TENTATIVE SON
	     CALL(FNDPSON,LAST)
	     POPACS
	     GO C1 ]
C1:	CALL(KILL,THIS)
	POPP 1↔AOS(P)↔POP1J
SUBREND KLVERT;18-FEB-73(TVR)
NSUBR FNDPSON,POLYGON	;FIND NEW SON IF SON HAS BEEN KILLED OR MOVED
	ACCUMULATORS{V0,V,TOP,CMIN,RMIN}
	MOVE 1,POLYGON
	TEST 1,PBIT
	GO [ FATAL(FNDPGON CALL WITH NON-POLYGON) ]
	SON V0,1
	MOVE TOP,V0
	ROW RMIN,TOP
	COL CMIN,TOP
	MOVE V,V0
L1:	ROW 1,V
	CAML 1,RMIN
	GO [ CAME 1,RMIN
	     GO L3
	     COL 0,V
	     CAML 0,CMIN
	     GO L3
	     GO L2 ]
	COL 0,V
L2:	MOVEM 1,RMIN
	MOVEM 0,CMIN
	MOVEM V,TOP
L3:	CCW V,V
	CAME V,V0
	GO L1
	MOVE 1,POLYGON
	SON. TOP,1
	POP1J
SUBREND FNDPSON;4-MAR-72(TVR)
NSUBR ORTHMUNG,OBJECT	;SEARCH FOR ORTHAGONAL LINES AND MUNG THEM ONTO PIXEL BOUNDARIES;
	ACCUMULATORS{C1,C2,C3,R1,R2,R3,V1,V2,V3,V0}
	MOVE 1,OBJECT
	JUMPE 1,POP1J.
	TEST 1,VBIT	;ARE WE AT VERTEX LEVEL YET?
	GO [	    TESTZ 1,FBIT
		    SON 1,1
	     OLOOP: PUSH P,1	      ;NO, SAVE OBJECT
		    SON 1,1,	      ;GET HIS SON
		    CALL(ORTHMUNG,1)  ;MUNG HIS RING
		    POP P,1	      ;GET BACK OBJECT
		    CCW 1,1	      ;NEXT IN RING
		    CAME 1,OBJECT     ;DONE YET?
		    GO OLOOP
		    POP1J ]	      ;YES,RETURN
	MOVE V0,1	;REMEMBER BEGINNING OF RING
	CW V1,V0	;INITIALIZE VERTEX POINTERS
	MOVE V2,V0
	ROW R1,V1↔ADDI R1,40↔ANDCMI R1,77  ;AND THEIR RESPECTIVE ROWS AND COLUMNS
	ROW R2,V2↔ADDI R2,40↔ANDCMI R2,77
	COL C1,V1↔ADDI C1,40↔ANDCMI C1,77
	COL C2,V2↔ADDI C2,40↔ANDCMI C2,77
	GO VL1			;SKIP ADVANCE CODE
VLOOP:	MOVE 0,[XWD C2,C1]	;ADVANCE TO NEXT VERTEX
	BLT V2
VL1:	CCW V3,V2		;UPDATE V3 AND RESPECTIVE ROW AND COLUMN
	ROW R3,V3↔ADDI R3,40↔ANDCMI R3,77
	COL C3,V3↔ADDI C3,40↔ANDCMI C3,77
	CAMN R1,R2		;WOULD THIS BE A RIGHT ANGLE?
	CAME C2,C3
	GO VL2			;NOT FROM ROW TO COLUMN
	MOVE 0,R2		;AND ARE BOTH LEGS LONGER THAN ORTHCON?
	SUB 0,R3
	MOVM 0,0
	CAIG 0,100
	GO VL3
;	CAMGE 0,ORTHCON
;	GO VL3			;ROW PART TOO SHORT
	MOVE 1,C1
	SUB 1,C2
	MOVM 1,1
	CAIG 1,100
	GO VL3
	IMUL 1,0
	CAMGE 1,ORTHCON
	GO VL3			;COLUMN PART TOO SHORT
	ROW. R1,V1		;MUNG ROW PART OF PREVIOUS
	COL. C3,V3		;MUNG COLUMN PART OF NEXT
	ROW. R2,V2		;MUNG BOTH OF THIS VERTEXS
	COL. C2,V2
	GO VL3			;DON'T BOTH WITH REST
VL2:	CAMN C1,C2		;HOW ABOUT FROM COLUMN TO ROW?
	CAME R2,R3
	GO VL3			;NOT THAT WAY EITHER
	MOVE 0,R1		;AND ARE BOTH LEGS LONGER THAN ORTHCON?
	SUB 0,R2
	MOVM 0,0
	CAIG 0,100
	GO VL3
;	CAMGE 0,ORTHCON
;	GO VL3			;ROW PART TOO SHORT
	MOVE 1,C2
	SUB 1,C3
	MOVM 1,1
	CAIG 1,100
	GO VL3
	IMUL 1,0
	CAMGE 1,ORTHCON
	GO VL3			;COLUMN PART TOO SHORT
	COL. C1,V1		;MUNG COLUMN PART OF PREVIOUS
	ROW. R3,V3		;MUNG ROW PART OF NEXT
	ROW. R2,V2		;MUNG BOTH OF THIS VERTEX
	COL. C2,V2
VL3:	CAME V3,V0		;DONE YET
	GO VLOOP
	PGON 1,V0
	CALL(FNDPSON,1)
	POP1J			;YES, RETURN
SUBREND ORTHMUNG
	INTERNAL ORTHCON
ORTHCON: 500
NSUBR SMOOTH,LEVEL
;BEGIN SMOOTH; -BGB- 6 DEC 1972.
	ACCUMULATORS{V1,V2,PG,E0,E1,E2}
	SKIPN FLGARC↔POP1J	;MAKE ARC ENABLED ?
	MOVE 1,ARG1
	TEST 1,LBIT
	GO [ FATAL(SMOOTH CALLED WITH NON-LEVEL)]
	SON PG,1↔SKIPN PG↔POP1J
	MOVEM PG,PG0#

;POLYGON INITIALIZATION.

L1:	MOVEM PG,PGSAVE#
	SON V1,PG↔MOVEM V1,E0SAVE#   ;UPPER MOST LEFT VERTEX.
	ARC V2,PG		   ;LOWER MOST RIGHT VERTEX.
	TESTZ V2,ARCBIT↔POP1J	   ;END OF LEVEL'S POLYGON RING.
	JUMPE V2,[CALL(KLARCP,PG)
		  MOVE PG,PGSAVE
		  ARC V2,PG
		  JUMPE V2,[FATAL<CAN'T SMOOTH THIS, ARC POINTER IN POLYGON>]
		  GO L1]

;CREATE ARC NODES AT POLYGON'S EXTREME CORNERS.

	SETQ(ARC2,{MAKE,[VBIT+ARCBIT+VREL]})
	MOVE RC(V2)↔MOVEM RC(1)↔ARC. 1,V2↔ARC. V2,1
	SETQ(ARC1,{MAKE,[VBIT+ARCBIT+VREL]})
	MOVE RC(V1)↔MOVEM RC(1)↔ARC. 1,V1↔ARC. V1,1

	MOVE 2,ARC2↔CCW. 1,2↔CW. 1,2↔CCW. 2,1↔CW. 2,1
	PGON. PG,1↔PGON. PG,2↔ARC. 1,PG

;CALL FOR CREATION OF THE INTERMEDIATE ARC NODES.
	SETZM AVCNT
	CALL(MKARCS,ARC1,ARC2)
	CALL(MKARCS,ARC2,ARC1)

;KILL TWO-SIDED ARC-POLYGONS AND ADVANCE TO NEXT POLYGON.
	SKIPN AVCNT↔GO[
		SETQ(PG,{KLPOLY,PGSAVE})
		JUMPN PG,L1↔POP1J]
;	CALL(FARCL,PGSAVE)
	MOVE PG,PGSAVE↔CCW PG,PG↔GO L1

	LIT
	DECLARE{ARC1,ARC2}
SUBREND SMOOTH;9-JAN-73(BGB),21-APR-73(TVR)
;_________________________________________________________________
	DECLARE{AVCNT}	;ARC-VERTEX COUNT.
NSUBR MKARCS,VERT1,VERT2	;MAKE ARCS  -  FROM U1 CCW TO U2
; BGB - AUG 1972.
	ACCUMULATORS{D,U1,U2,V1,V2,A,B,C,U,V}
	MOVE V1,ARG2↔MOVE V2,ARG1
;CHECK FOR TRIVIAL CASE.
L0:	ARC U1,V1↔ARC U2,V2
	CCW 0,U1↔CAMN 0,U2↔GO L3

;COMPUTE NORMALIZED ARC EDGE COEFFICIENTS.
	ROW A,V1↔FLO A,		; A ← Y1.
	COL B,V2↔FLO B,		; B ← X2.
	COL C,V1↔FLO C,		; C ← X1.
	ROW D,V2↔FLO D,		; D ← Y2.
	MOVE 1,B↔FMPR 1,A	; 1 ← X2*Y1.
	FSBR A,D↔FSBR B,C	; A ← Y1-Y2.   B ← X2-X1.
	FMPR C,D↔FSBR C,1	; C ← X1*Y2 - X2*Y1.
	MOVE 0,A↔FMPR 0,0↔MOVE 1,B↔FMPR 1,1↔FADR 1,0
	CALL SQRT,1↔FDVR A,1↔FDVR B,1↔FDVR C,1
	MOVE 0,A↔FMPR 0,A↔HLLM 0,6(V1)
	MOVE 0,B↔FMPR 0,B↔HLRM 0,6(V1)

;SET 'EM UP FOR AN ARC PASS.
	ARC U1,V1↔ARC U2,V2
	SETZM DMAX#↔SETZM DMIN#
	SETZM VMAX#↔SETZM VMIN#
	SETZM MAXCON#
;GO FROM U1 CCW TO U2 AND FIND THE U FURTHEST OFF THE ARC-EDGE.
L1:	CCW U1,U1↔CAMN U1,U2↔GO L2
	COL 0,U1↔FLO 0,↔ROW 1,U1↔FLO 1,
	FMPR 0,A↔FMPR 1,B↔MOVE D,C↔FADR D,0↔FADR D,1
	CAMGE D,DMIN↔GO [MOVEM U1,VMIN↔MOVEM D,DMIN↔GO .+1]
	CAMLE D,DMAX↔GO [MOVEM U1,VMAX↔MOVEM D,DMAX↔GO .+1]
;KEEP TRACK OF MAXIMUM EDGE CONTRAST ALONG ARC.
;	CNTRST 0,V1↔MOVM↔CAMLE MAXCON↔MOVEM MAXCON↔GO L1	;FLUSHED FOR TVFONT
	GO L1

;WHEN EXTREMA EXCEED ARCWID[MAXCON] THEN FORM ARC-POINTS.
L2:	MOVE U,VMIN↔MOVM DMIN
	CAMGE DMAX↔MOVE U,VMAX
	CAMGE DMAX↔MOVE DMAX
;	MOVE 1,MAXCON↔CAMGE ARCWID(1)↔GO L3		;FLUSHED FORN TVFONT
	CAMGE ARCWID↔GO L3
;OLDE ESPLIT.
	SETQ(V,{MAKE,[VBIT+ARCBIT+VREL]})↔AOS AVCNT
	ARC. U,V↔ARC. V,U
	MOVE RC(U)↔MOVEM RC(V)↔PGON 0,U↔PGON. 0,V
	CCW. V,V1↔CW. V1,V
	CCW. V2,V↔CW. V,V2
	MOVE V2,V↔GO L0

;ADVANCE CCW AN ARC-EDGE OR EXIT.
L3:	CAMN V2,ARG1↔POP2J
	MOVE V1,V2↔CCW V2,V2↔GO L0
SUBREND MKARCS;28-DEC-72(BGB)
NSUBR FARCL,PGON	;FIT ARCS LINEAR.
;BEGIN FARCL
	X←←1
	ACCUMULATORS{Y,SX,SY,XX,YY,XY,N,E,U1,U2,V1,V2}

;Clear the Locus of all the Arc Vertices.
;	MOVE E,PGON↔DAD E,E↔MOVEM E,E0#
	MOVE E,PGON↔ARC E,E↔MOVEM E,E0#
	CCW V1,E ↔ SETZM RC(V1)
	CCW E,V1 ↔ CAME E,E0↔JRST .-4

;Advance along Polygon.
	CW V2,E
L1:	MOVE V1,V2↔CCW V2,E
	ARC U1,V1↔ARC U2,V2
;	CW U1,U1↔CW U1,U1
;	CW U1,U1↔CW U1,U1
;	CW U1,U1↔CW U1,U1
;	CCW U2,U2↔CCW U2,U2
;	CCW U2,U2↔CCW U2,U2
;	CCW U2,U2↔CCW U2,U2

;Arc Scan Initialization.
	MOVE [XWD SX,SY]↔SETZ SX,↔BLT N↔JRST L2A
;Advance along VIC within the ARC.
;L2:	CCW U1,U1↔CCW U1,U1
L2:	CCW U1,U1
;Accumulate a Point.
L2A:	COL X,U1↔FLO X,↔ROW Y,U1↔FLO Y,
	FADR SX,X ↔ FADR SY,Y
	MOVE X ↔ FMPR Y ↔ FADR XY,0
	FMPR X,X ↔ FADR XX,X
	FMPR Y,Y ↔ FADR YY,Y
	CAME U1,U2↔AOJA N,L2↔AOS N
;----- FARCL		COMPUTE SYMMETRIC LEAST SQUARES LINE COEFFICIENTS.
; Q ← N*XY - SY*SX.
; A ← Q + SY*SY - N*YY.
; B ← Q + SX*SX - N*XX.
; C ← SX*YY + SY*XX - XY*(SX+SY).

L3:	MOVE 2,SX↔FMP 2,YY
	MOVE 0,SY↔FMP 0,XX↔FAD 2,0
	MOVE SX↔FAD SY↔FMP XY↔FSB 2,0↔MOVEM 2,CCCC#

	FSC N,233↔FMP XX,N↔FMP XY,N↔FMP YY,N	;all the N terms.
	MOVE SX↔FMP SY↔FSB XY,0				;Q in XY.

	FMP SY,SY↔FAD SY,XY↔FSB SY,YY↔MOVEM SY,AAAA#
	FMP SX,SX↔FAD SX,XY↔FSB SX,XX↔MOVEM SX,BBBB#

	FMP SY,SY↔FMP SX,SX↔FAD SX,SY
	MOVSI(1.0)↔FDVR SX↔MOVEM QQQQ#	;PSEUDO NORMALIZATION.

;SOLVE FOR THE LOCII WHERE PERPENDICULARS DROPPED FROM
;THE ARC-EDGE HIT THE FITTED LINE.
; Q ← 1/(A*A + B*B).
; D ← (B*X1 - A*Y1).
; X ← (B*D - A*C)*Q.
; Y ←-(A*D + B*C)*Q.

L4:	ARC U1,V1
	COL X,U1↔FLO X,↔ROW Y,U1↔FLO Y,
	FMP X,BBBB↔FMP Y,AAAA↔FSBR X,Y↔MOVN Y,X		;DDDD.
	FMP X,BBBB↔FMP Y,AAAA
	MOVE AAAA↔FMP CCCC↔FSBR X,↔FMPR X,QQQQ↔FIX X,226000
	MOVE BBBB↔FMP CCCC↔FSBR Y,↔FMPR Y,QQQQ↔FIX Y,226000
	HRLM Y,X↔ADDM X,RC(V1)

	ARC U2,V2
	COL X,U2↔FLO X,↔ROW Y,U2↔FLO Y,
	FMP X,BBBB↔FMP Y,AAAA↔FSBR X,Y↔MOVN Y,X		;DDDD.
	FMP X,BBBB↔FMP Y,AAAA
	MOVE AAAA↔FMP CCCC↔FSBR X,↔FMPR X,QQQQ↔FIX X,226000
	MOVE BBBB↔FMP CCCC↔FSBR Y,↔FMPR Y,QQQQ↔FIX Y,226000
	HRLM Y,X↔ADDM X,RC(V2)

	CCW E,V2↔CAME E,E0↔JRST L1
	MOVE 12,AC12↔POP1J
SUBREND FARCL;6-JAN-73(BGB)
NSUBR KILVIC,LEVEL	;KILL VIDEO INTENSITY CONTOURS OF THE PREVIOUS LEVEL.
; BGB - 5 JANUARY 1973.
	ACCUMULATORS{PG,E0,E1,E2,PG0}

	SKIPN FLGARC↔POP1J	;MAKE ARC ENABLE.
	SKIPN FLGU↔POP1J
	MOVE 1,ARG1
	TEST 1,LBIT
	GO [ FATAL(KILVIC CALLED WITH NON-LEVEL)]
	CW 1,1
	SON PG,1
	SKIPN PG0,PG↔POP1J

;RELEASE VIC NODES OF THE POLYGON.
L1:	SON E0,PG
	JUMPE E0,L3
	SETZ↔SON. 0,PG
	MOVE  E1,E0
L2:	CCW  E2,E1
	SETZ 0↔ARC 1,E1↔SKIPE 1↔ARC. 0,1
	CALL(KILL,E1)
	CAMN E2,E0↔GO L3
	MOVE  E1,E2↔GO L2

;ADVANCE TO NEXT POLYGON ON THIS LEVEL.
L3:	CCW PG,PG
	CAME PG,PG0↔GO L1
	POP1J

SUBREND KILVIC;5-JAN-73(BGB)
;SUBRS KLARCL,KLARCP	;KILL ARCS OF LEVEL, OF POLYGON
NSUBR KLARCL,LVL	;KILL ARCS OF POLYGONS OF LEVEL
	HRRZ 1,LVL
	TEST 1,LBIT
	GO [FATAL(KLARCL CALLED WITH NON-LEVEL)]
	SON 1,1
	MOVEM 1,PG0#
L1:	CALL(KLARCP,1)
	MOVE 1,1(P)
	CCW 1,1
	CAME 1,PG0
	GO L1
	POP1J
SUBREND KLARCL;27-FEB-73(TVR)
;_________________________________________________________________
NSUBR(KLARCP,POLYGON)
	ACCUMULATORS{PG,V0,V1,V2,XMAX,YMAX}

	HRRZ PG,POLYGON
	TEST PG,PBIT
	GO [FATAL(KLARCP CALLED WITH NON-POLYGON)]
	SON 1,PG		;HAS HE BEEN ZAPPED?
	JUMPE 1,POP1J.		;YES
	ARC V0,PG		;GET ARC RING
	JUMPE V0,FINDLR		;NONE THERE, MUST BE OLDE STYLE
	TEST V0,ARCBIT		;IS IT AN ARC
	GO FINDLR		;NO, CHECK LOWER RIGHT, JUST TO BE SURE
	SETZ 0,			;FOR ZEROING POINTERS
	MOVE V1,V0
L1:	ARC 1,V1		;GET CORRESPONDING VIC NODE
	SKIPE 1			;IS THERE ONE?
	ARC. 0,1		;ZERO HIS POINTER
	CCW V2,V1		;REMEMBER WHOSE NEXT
	CALL(KILL,V1)		;FLUSH ARC
	CAMN V2,V0		;DONE YET?
	GO FINDLR		;YES, NOW FIND LOWER RIGHT VERTEX
	MOVE V1,V2		;GET NEXT ARC
	GO L1			;AND REPEAT
FINDLR:	SON V0,PG		;GET VIC RING
	ROW YMAX,V0		;INIT X AND Y DEFAULTS
	COL XMAX,V0
	MOVE V1,V0
	ARC. 0,PG		;IN CASE WE DON'T FIND ANY
L2:	CCW V1,V1		;GET NEXT VERTEX
	CAMN V1,V0		;AT END?
	POP1J			;YES, WE'RE DONE
	ROW 1,V1
	CAMGE 1,YMAX
	GO L2
	CAME 1,YMAX
	GO [ COL 1,V1
	     CAMG 1,XMAX
	     GO L2
	     GO C1]
C1:	ROW YMAX,V1		;NEW X AND Y
	COL XMAX,V1
	ARC. V1,PG		;NEW LR VECTOR
	GO L2
SUBREND KLARCP;27-FEB-73(TVR)
NSUBR(ARCVIC,LVL);MAKE ARC RING INTO VIC RING
	ACCUMULATORS{P0,P1,V0,V1,MASK}
	HRRZ 1,LVL
	TEST 1,LBIT
	GO [FATAL(ARCVIC CALLED WITH NON-LEVEL)]
	SON P1,1
	ARC V0,P1		;MAKE SURE THERE AN ARC RING
	JUMPE V0,POP1J.
	TEST V0,ARCBIT
	POP1J
	CALL(KILVIC,LVL)	;FLUSH OLD VIC RING
	HRRZ 1,LVL
	SON P0,1
	MOVE P1,P0
	SETZ 0,			;FOR ZEROING POINTERS
	MOVSI MASK,(ARCBIT)	;FOR FLUSHING ARC BITS IN TYPE FIELD
L1:	ARC V0,P1		;MOVE ARC RING TO VIC RING POSITION
	SON. V0,P1
	ARC. 0,P1
	MOVE V1,V0
L2:	ANDCAM MASK,2(V1)	;FLUSH ARCBIT AND ARC POINTER AROUND RING
	HRRZS 4(V1)
	CCW V1,V1		;NEXT VECTOR
	CAME V1,V0		;END OF ARC RING?
	GO L2			;NO
	CCW P1,P1		;NEXT POLYGON
	CAME P1,P0		;END OF POLYGON RING
	GO L1			;NO
	GO KLARCL		;NOW, FIND LOWER RIGHT FOR FUTURE SMOOTHING
SUBREND ARCVIC;27-FEB-73(TVR)